perm filename ENTROG.SAI[PIX,HPM] blob
sn#442981 filedate 1979-05-20 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 BEGIN "ENTRO5"
C00007 ENDMK
C⊗;
BEGIN "ENTRO5"
REQUIRE "PIXHDR.SAI[VIS,HPM]" SOURCE_FILE;
DEFINE NLIST=112000; INTEGER LAVAIL;
SAFE INTEGER ARRAY LIST[0:NLIST]; SAFE REAL ARRAY PRED[0:NLIST];
INTEGER I,J,K,L,C,D,DD,E,F,PICLNBY; REAL INF,INP,PA,PB,LINF,LINP;
STRING BF; INTEGER SAFE ARRAY PIC[0:10];
DEFINE L2LEN=5000;
REAL SAFE ARRAY L2[0:L2LEN];
INTEGER CONTEX,CONTEX2;
IF FALSE THEN
BEGIN STRING A; EQU(A,A); CALL(0,0); A←CVXSTR(0); A←CVSIX("0"); A←A[1 TO 1]; END;
FOR I←0 STEP 1 UNTIL L2LEN DO L2[I]←-LOG((I/L2LEN) MAX 0.00001)/LOG(2);
DO PRINT("BIT FILE:") UNTIL PFLDIM(BF←INCHWL)>0;
WHILE TRUE DO
BEGIN
INTEGER CH; STRING S;
PRINT("Window size (must be odd):"); CONTEX←CVD(INCHWL); CONTEX2←CONTEX*CONTEX;
PRINT("Gain rate (ε):"); PA←REALSCAN(S←INCHWL,I); PB←1-PA;
CH←OPNPFL(BF,PIC[0]);
PICLNBY←PIC[LNBY];
BEGIN
INTEGER ARRAY HASH[0:(1 ASH ((CONTEX2-1)%2))-1];
INTEGER SAFE ARRAY BPS[0:CONTEX-1,0:CONTEX-1],BPT[0:CONTEX2-1];
INTEGER SAFE ARRAY BITS[0:CONTEX-1,-1:PIC[LNWD]-1];
ARRCLR(HASH,0); LAVAIL←NLIST;
FOR I←0 STEP 1 UNTIL CONTEX-1 DO
FOR J←0 STEP 1 UNTIL CONTEX-1 DO
BPS[I,J]←POINT(1,BITS[I,-1],36-CONTEX+J);
INF←0; INP←0; LINF←LINP←0;
FOR L←0 STEP 1 UNTIL PIC[PCLN]-1 DO
BEGIN
ARRYIN(CH,BITS[L MOD CONTEX,0],PIC[LNWD]);
FOR I←0 STEP 1 UNTIL CONTEX-2 DO
FOR J←0 STEP 1 UNTIL CONTEX-1 DO BPS[I,J]↔BPS[I+1,J];
ARRBLT(BPT[0],BPS[0,0],CONTEX2);
FOR J←0 STEP 1 UNTIL PICLNBY-1 DO
BEGIN
D←ILDB(BPT[0]); DD←ILDB(BPT[1]);
FOR K←2 STEP 2 UNTIL CONTEX2-3 DO
BEGIN
D←(D LSH 1) LOR ILDB(BPT[K]);
DD←(DD LSH 1) LOR ILDB(BPT[K+1]);
END;
F←E←HASH[D];
WHILE E>0 ∧ (LIST[E] LSH -18)≠DD DO
BEGIN
F←E;
E←LIST[E] LAND '777777;
END;
IF E>0 THEN C←E ELSE
BEGIN
LAVAIL←LAVAIL-1; IF LAVAIL≤0 THEN
BEGIN PRINT("out of storage!!!"); CALL(0,"EXIT"); END;
LIST[LAVAIL]←(DD LSH 18);
PRED[LAVAIL]←0.5;
IF F=0 THEN HASH[D]←LAVAIL ELSE LIST[F]←LIST[F] LOR LAVAIL;
C←LAVAIL;
END;
IF ILDB(BPT[CONTEX2-1]) THEN
BEGIN
INF←INF + L2[L2LEN*PRED[C]];
PRED[C]←(PRED[C]*PB+PA) MIN .99999;
END
ELSE
BEGIN
INF←INF + L2[L2LEN*(1-PRED[C])];
PRED[C]←(PRED[C]*PB) MAX .00001;
END;
END;
INP←INP+PICLNBY;
IF (L MOD 100)=0 THEN
BEGIN
PRINT(INP,"/",INF," = ",INP/INF," local ",(INP-LINP)/(INF-LINF),'15&'12);
LINF←INF; LINP←INP;
END;
END;
PRINT(INP,"/",INF," = ",INP/INF," local ",(INP-LINP)/(INF-LINF),'15&'12);
E←0; D←HASH[0]; WHILE D>0 DO BEGIN E←E+1; D←LIST[D] LAND '777777; END;
PRINT("HASH[0] length ",E,'15&'12);
END;
RELEASE(CH);
END;
END "ENTRO5";